perm filename LOOP.FAI[XX,LCS]20 blob
sn#258355 filedate 1977-01-16 generic text, type C, neo UTF8
COMMENT ⊗ VALID 00002 PAGES
C REC PAGE DESCRIPTION
C00001 00001
C00002 00002 TITLE LOOP SUBROUTINE LOOP(I,J,L,M,N)
C00045 ENDMK
C⊗;
TITLE LOOP ; SUBROUTINE LOOP(I,J,L,M,N)
ENTRY LOOP,FINDIT,PLACE,DPYNEW,MVBEAM,MVBX,JUGGLE,XNOTE,BAUTO
ENTRY SORT2,UPDATE,NEWR,MSSLUP,LUP2,HOMER,FSCAN,NALF,BOX,PARCH
EXTERNAL ACCPOG,DPYOUT,.COMM.,XRN,AMOD,PTR,KJY,DPY,DL,SCM
EXTERNAL SC,SCX,RRJJ,STF,ALF,POSI,RMOD,RINP,SIZ
EXTERNAL RHORZ,SETCUR,DPYSET,DPYBRT,SETPOG,ALINE
DEFINE FIXX(N)
< KIFIX N,N ↔ > ; NEW KL10 FIX
; DIMENSION N(1)
MM←1 ↔ NN←2 ↔ JK←3 ↔JT←4 ↔IEND←5 ↔A←6 ↔K←7↔ IS←10↔ IZ←11↔ R←12↔ L←13
RC←14 ↔ NX←15 ;**** AC'S 0,1,2,3,5 ARE USED IN 'PLACE' & 'FINDIT'!!
LOOP: 0 ; DO 1 NN=I+L,J+L,K
MOVE 1,@4(16)
SUB 1,@3(16) ; MM IS IN 1
MOVE 2,@(16)
ADD 2,@3(16) ;I+L -- NN, 1ST TIME
MOVE 3,@1(16)
ADD 3,@3(16) ;J+L
MOVE 4,@2(16) ;K
HRRZI 5,@5(16) ; ADR. OF N
ADDI 2,-1(5) ; N(NN)
ADDI 3,-1(5)
JUMPL 4,LP3 ; JUMP IF NEG. INCR.
HRRM 1,.+1 ; ADD IN MM
LP1: MOVE 6,(2)
MOVEM 6,(2) ;N(NN)=N(NN+MM)
CAIGE 2,(3)
AOJA 2,LP1
JRA 16,6(16)
LP3: HRRM 1,.+1
LP2: MOVE 6,(2) ;NEG. INCR.
MOVEM 6,(2)
CAILE 2,(3)
SOJA 2,LP2
JRA 16,6(16) ; END
PLACE: 0 ; FUNCTION PLACE(X)
; COMMON R2,JA,CENTR,J2,RJQ(20),JQ(20)/XRN/RN(4000)
; EQUIVALENCE (R11,RJQ(9)),(RD,RN(4000))
MOVN 2,@(16) ; PLACE=R11-ABS(RD-X)
FADR 2,RMOD+=9 ;END
MOVMS 2
MOVE 0,.COMM.+=12 ;R11
FSBR 0,2
JRA 16,1(16)
FINDIT: 0 ; FUNCTION FINDIT(N)
SETZ ; COMMON R2,JA,CENTR,J2,RJQ(20),JQ(20)
HRRZ 1,@(16) ; COMMON /XRN/RN(4000) /PTR/PWDS(250),ITEM,L,I,IX
;; HRRZI 2,PTR ; FINDIT=0
;; ADDI 1,(2) ; L=PWDS(N)
;; MOVE 2,-1(1) ; IF(RN(L+1).NE.1)GO TO 377
;; FIXX(2) ; IF(RN(L+2).EQ.R2)RETURN
;; HRRZI 3,XRN ;377 FINDIT=-1
;; ADDI 3,(2) ; END
;; MOVE 5,(3) ; RN(L+1)
MOVE 2,PTR-1(1) ;THESE 3 REPLACE ABOVE
;X FIXX(2)
MOVE 5,XRN(2)
CAME 5,[1.0]
JRST FNEG
MOVEM 2,PTR+=251 ; SENDS BACK A NUM IN L
;; MOVE 5,1(3) ;RN(L+2)
MOVE 5,XRN+1(2)
CAME 5,.COMM.
FNEG: SETO
JRA 16,1(16)
DPYNEW: 0 ; SUBROUTINE DPYNEW
JSA 16,ACCPOG ; COMMON/DPY/ST(4000),WDS(250),MEDIT,IGO
JUMP [1] ; CALL ACCPOG(1)
MOVE 2,DPY+=4251 ; IF(IGO.GT.0)RETURN
JUMPG 2,DB ; CALL DPYOUT(1)
JSA 16,DPYOUT ; END
JUMP [1]
DB: JRA 16,(16)
MVBEAM: 0 ;C THESE MOVE ENDS OF PARTIAL INNER BEAMS.
HRRZ 2,(16) ; SUBROUTINE MVBEAM(R,I,JY,L,W)
ADD 2,@1(16) ; +I
MOVE 3,2 ;C L AND JY ARE FOR MOVES TO DIFF. STAFF.
ADD 2,@2(16) ; +JY DIMENSION R(1)
MOVE 2,-1(2) ; Y=R(JY+I)
; Z=ABS(Y)
; IF(Z.LT.100.)GO TO 1
; IF(I.GT.5)GO TO 1
;C NEXT FOR MINIS, DIAMONDS, 'X' NOTES. (LIMIT OF +-99 ON ALTITUDE.)
; Y=AMOD(Y,100.)
; Z=Z-ABS(Y)+ABS(X)
; IF(X)Z=-Z
; GO TO 2
FADR 2,@4(16) ;1 Z=Y+W
ADD 3,@3(16) ; +L
MOVEM 2,-1(3) ; PUT IT IN R(L+I)
JRA 16,5(16) ; END
MVBX: 0 ; SUBROUTINE MVBX(I)
; COMMON R2,JA,CENTR,J2,RJQ(20),L,RDIS,JQ(18)/KJY/K,JY/XRN/R(4000)
HRRZI 1,XRN ; LOC OF XRN
ADD 1,@(16) ; EQUIVALENCE (R4,RJQ(2)),(R8,RJQ(6))
MOVE 2,1
ADD 2,KJY+1 ; R(L+I)=R8+(R(JY+I)-R4)*RDIS
MOVE 3,-1(2)
FSBR 3,.COMM.+5
FMPR 3,.COMM.+=25 ; *RDIS
FADR 3,.COMM.+=9 ; +R8
ADD 1,.COMM.+=24 ; + L
MOVEM 3,-1(1)
JRA 16,1(16)
JUGGLE: 0 ; SUBROUTINE JUGGLE
; IMPLICIT INTEGER(A-Z)
; REAL PWDS,RN
; COMMON /DL/X22,SAVER,NAME /XRN/RN(4000)
; COMMON/PTR/PWDS(250),ITEM,L,I,IX/DPY/ST(4000),WDS(250),MEDIT,IGO
SOS PTR+=250 ;ITEM=ITEM-1
HRRZI 15,XRN ; JX=RN(MEDIT)+3 WD CNT OF OLD ITEM
;C I-IX IS WD CNT OF NEW ITEM
ADD 15,DPY+=4250
KIFIX 14,-1(15) ;MOVE 14,-1(15)
ADDI 14,3 ; JX
MOVE 13,PTR+=253 ;JY=IX
MOVE 11,PTR+=252 ; I
SUB 11,13
SUB 11,14 ;Z=I-IX-JX SPACE CHANGE
JUMPL 11,J2751 ;IF(Z)2751,172,751
JUMPE 11,J172
MOVE 5,PTR+=252 ;751 CALL LOOP(I-1,MEDIT+JX,-1,Z,0,RN)
SUBI 5,1
MOVE 10,DPY+=4250
ADD 10,14
JSA 16,LOOP
JUMP 5
JUMP 10
JUMP [-1]
JUMP 11
JUMP [0]
JUMP XRN
ADD 13,11 ;JY=IX+Z
JRST J172 ;GO TO 172
J2751: ADD 14,DPY+=4250 ;2751 CALL LOOP(MEDIT+JX+Z,IX+Z-1,1,0,-Z,RN)
ADD 14,11
MOVE 5,11
ADD 5,PTR+=253
SOJ 5,
MOVN 10,11
JSA 16,LOOP
JUMP 14
JUMP 5
JUMP [1]
JUMP [0]
JUMP 10
JUMP XRN
;172 J=RN(JY)+2
J172: KIFIX 12,XRN-1(13) ;MOVE 12,XRN-1(13)
ADDI 12,2 ; J IS IN 12
JSA 16,LOOP ;CALL LOOP(0,J,1,MEDIT,JY,RN)
JUMP [0]
JUMP 12
JUMP [1]
JUMP DPY+=4250 ; MEDIT
JUMP 13 ; JY
JUMP XRN
MOVE 12,PTR+=253 ; I=IX+Z
ADD 12,11 ; Z IS IN 11
MOVEM 12,PTR+=252
MOVE 12,PTR+=250 ; 1751 X=ITEM+1
AOJ 12, ; X IS IN 12
HRRZI 13,DPY+=4000 ; JX=WDS(X22+1)-WDS(X22)
ADD 13,DL
MOVE 14,(13) ; WDS(X22+1) IN 14 ADR. WDS(X22) IN 13
SUB 14,-1(13) ;JX IN 14
HRRZI 10,DPY+=4000 ; J=WDS(X+1)-WDS(X)
ADDI 10,(12)
MOVE 7,(10) ;WDS(X+1)
SUB 7,-1(10) ;J IN 7
MOVEM 7,MVBX ; STORE J
SUB 7,14 ; Y=J-JX
MOVE 14,-1(10) ; JX=WDS(X)+Y+1
ADD 14,7
AOJ 14, ; JX IN 14
JUMPL 7,J2851 ; IF(Y)2851,182,282
JUMPE 7,J182
MOVE 15,(10) ;282 CALL LOOP(WDS(X+1)+2,WDS(X22),-1,Y,0,ST)
ADDI 15,2 ; ARG 1
MOVE 6,-1(13) ; ARG 2
JSA 16,LOOP
JUMP 15
JUMP 6
JUMP [-1]
JUMP 7 ; Y
JUMP [0]
JUMP DPY
JRST J182 ; GO TO 182
J2851: MOVE 14,(13) ;2851 CALL LOOP(WDS(X22+1)+Y+1,WDS(X)+Y+1,1,0,-Y,ST)
ADD 14,7 ;+Y
ADDI 14,1 ; ARG 1
MOVE 5,-1(10) ;WDS(X)
ADD 5,7
ADDI 5,1 ; ARG 2
MOVNM 7,MVBEAM ; -Y IS STORED
JSA 16,LOOP
JUMP 14
JUMP 5
JUMP [1]
JUMP [0]
JUMP MVBEAM
JUMP DPY
MOVE 14,-1(10) ; WDS(X) JX=WDS(X)+1
ADDI 14,1 ; JX IN 14
J182: MOVE 5,-1(13) ;182 CALL LOOP(1,J,1,WDS(X22)+1,JX,ST)
ADDI 5,1 ;WDS(X22)+1
JSA 16,LOOP
JUMP [1]
JUMP MVBX
JUMP [1]
JUMP 5
JUMP 14
JUMP DPY
MOVE 2,DL ; DO 183 K=X22+1,X
; 183 WDS(K)=WDS(K)+Y
HRRZI 3,PTR
ADDI 3,(2)
J183: JUMPE 11,J184 ;IF(Z.EQ.0)GO TO 184
ADDM 11,(3) ; PWDS(K)=PWDS(K)+Z
AOJ 3, ;UPDATE PWDS AND WDS
J184: JUMPE 7,J185
ADDM 7,(13)
AOJ 13,
J185: CAIGE 2,(12)
AOJA 2,J183 ;ST(2)=WDS(X)
MOVE 2,DPY+=3999(12)
MOVEM 2,DPY+1
SETZM DL ;X22=0
JRA 16,(16)
SORT2: 0 ;SUBROUTINE SORT2(RPOS,M)
MOVEI 2,2 ;DIMENSION RPOS(2,200)
S3: MOVE 6,2 ;(K=L HERE)
SETO 11, ;L=2
HRRZI 3,@(16) ;3 J=-1
MOVE 4,2 ;RX=RPOS(1,L-1)
SUBI 4,1 ;L-1
IMULI 4,2
ADDI 4,(3)
MOVE 5,-2(4) ;RX
S2: MOVE 7,6 ; DO 2 K=L,M
;IF(RPOS(1,K).GE.RX)GO TO 2
IMULI 7,2 ;IF(RPOS(1,K).GE.RX)GO TO 2
ADDI 7,(3)
CAMG 5,-2(7)
JRST S1 ; CONTINUE
MOVE 5,-2(7) ; RX=RPOS(1,K)
;;C WHY WERE ALL THE RX'S JX ????? 9/6/73
MOVE 11,6 ;J=K
S1: CAMGE 6,@1(16) ;2 CONTINUE
AOJA 6,S2
JUMPL 11,S4 ;IF(J)GO TO 4
MOVE 12,2 ;K=L-1
SOS 12
IMULI 12,2 ;(K*2)
ADD 12,3 ;CALL EXCH(RPOS(1,K),RPOS(1,J))
MOVE 10,-2(12)
IMULI 11,2
ADD 11,3
EXCH 10,-2(11)
MOVEM 10,-2(12)
MOVE 10,-1(12) ;CALL EXCH(RPOS(2,K),RPOS(2,J))
EXCH 10,-1(11)
MOVEM 10,-1(12)
S4: CAMGE 2,@1(16) ;4 L=L+1
AOJA 2,S3 ;IF(L.LE.M)GO TO 3
JRA 16,2(16) ;END
XNOTE: 0 ;FUNCTION XNOTE(J)
MOVE 3,@(16) ;COMMON/XRN/RN(4000)
IMULI 3,12 ;DIMENSION R(10,80)
;EQUIVALENCE (R,RN(3001))
;XNOTE=AMOD(R(4,J),100.)
MOVE 2,RINP-7(3)
JSA 16,AMOD
JUMP 2
JUMP [=100.0]
CAML [80.0] ;IF(XNOTE.GE.80)XNOTE=XNOTE-100
FSBR [100.0] ; FOR NEG. MINIS, ETC.
MOVE 2,RINP-1(3) ;GET R(10,J)
JUMPE 2,.+5 ;IF 0, RETURN
MOVE 3,[5.0] ; ON STF ABOVE, +5 HGT.
CAMN 2,[1.0] ; 1=STF BELOW
MOVNS 3 ; MAKE IT -5
FADR 3 ;ADD IT TO XNOTE
JRA 16,1(16) ;END
BAUTO: 0 ; SUBROUTINE BAUTO(J,L,K,N)
;C FOR AUTOMATIC BEAMS.
MOVEI 2,2 ;COMMON/SCM/V(78),I,LCNT,STAFF,LIST(200),REND
ADDB 2,@(16) ;J=J+2
MOVE 4,@1(16)
SUB 4,@3(16) ;L-N
MOVE 5,@2(16)
SUB 5,@3(16) ;K-N
FLTR 4,4 ;TLC 4,232000
MOVEM 4,SC+16(2) ;VX(J-1)=L-N
;**** A LIMIT OF 25 BEAMS PER LINE.
FLTR 5,5 ;TLC 5,232000
MOVEM 5,SC+17(2) ;VX(J)=K-N
JRA 16,4(16)
UPDATE: 0 ; SUBROUTINE UPDATE(I)
;; HRRZI 3,XRN ;COMMON /PTR/PWDS(250),ITEM,LL,IS,IX /XRN/RN(4000)
;; ADD 3,PTR+=252 ;RN(IS)=I
MOVE 3,PTR+=252
FLTR 2,@(16) ;MOVE 2,@(16)
MOVEM 2,XRN-1(3)
;IS=IS+I+3
MOVE 2,@(16)
ADDI 2,3
ADDM 2,PTR+=252
JRA 16,1(16)
IK: 0 ;***** DON'T USE THESE ELSEWHERE, THEY STORE NUMBS.!!
JIT: 0 ; THESE ARE TO STORE PNTRS IN LOOP
NEWR: 0 ; SUBROUTINE NEWR
MOVE A,SC+=70 ;COMMON/PTR/PWDS(250),ITEM,LL,IS,IX
CAIE A,1 ;COMMON/XRN/RN(4000)
JRST N1 ;COMMON/SCM/V(78),I,LCNT,STAFF,LIST(200),REND
MOVE JK,PTR+=252;COMMON/SCX/RHY(4),JALPHA(30),JX,U,JZ,IRHY,J4,KA,KB,IZ
MOVEM JK,IK ;1 /SC/J,L,MK,ISKP,XMINUS,N,IEXP,LK,NNUM,JJ,JA,DBST,NFLG
MOVE JT,PTR+=250 ;1 ,IXX,ISEMI,IQT,VX(50),IAMP,K,KN,M,MODE,IBLA
MOVEM JT,JIT ;DIMENSION R(10,80)
N1: MOVE IS,IK ;EQUIVALENCE (R,RN(3001))
MOVEM IS,PTR+=252
MOVE 14,[9999.0]
MOVE JT,JIT ;IF(MODE.NE.1)GO TO 1
ADDI JT,1 ;IK=IS
MOVEM JT,PTR+=250 ;HOMER=ITEM
MOVEI K,=10 ;1 IS=IK
MOVE IZ,SCX+=41 ;ITEM=HOMER+1 ******************** WAS +=33
IMULI IZ,=10 ;MODE 1=NOTE, 2=RHYTH, 3=ACCENTS, 4=BEAMS, 5=SLURS.
;;N2: HRRZI R,XRN+=2997 ;DO 2 K=1,IZ
;;;;N2: MOVE R,XRN+=2997(K) ;DO 2 K=1,IZ
;; ADD R,K ;IF(R(8,K).EQ.9999.)GO TO 2
N2: CAMN 14,RINP-3(K)
JRST NN2 ;SKIPS INVIS RESTS - ONLY NEEDED IN RHYTH.
SETO IEND, ;C JUMP FOR BEAM CONT.
;; HRRZI L,XRN ;IEND=-1
MOVE IS,RINP-=10(K) ;GET CODE NUM. FROM R(1,K)
CAMN IS,[1.0] ;IF IT IS 1, IEND=0
SETZ IEND,
MOVE L,PTR+=252 ;RN(IS+3)=0
SETZM XRN+2(L) ;RN(IS+2)=0
SETZM XRN+1(L)
;; SETZM LOOP ;LOOP=0 FOR P2→P11 TRANSFER
MOVEI L,=10 ;C ↑↑↑↑ TO CLEAR ARRAY FOR SHORT ITEMS (CLEFS)
N3: HRRZI R,RINP(K) ;DO 3 L=10,1,-1
ADDI R,(L) ;A=R(L,K)
MOVE A,-13(R) ;(OCTAL) =13
JUMPGE IEND,NX4 ;IF(A.NE.0)GO TO 77
JUMPN A,NX3 ;IF(IEND)GO TO 3
JRST NN3
NX3: MOVE IEND,L ;77 IF(IEND)IEND=L
NX4: MOVE R,PTR+=252
ADDI R,(L)
MOVEM A,XRN-1(R) ;RN(IS+L)=A
NN3: CAILE L,1 ;3 CONTINUE
SOJA L,N3
MOVE A,SCM+=80 ;A=STAFF #
MOVEM A,XRN(R) ;PUT IT IN P2
CAME IS,[1.0] ;IF NOT CODE 1, SKIP OVER
JRST N4
MOVEI IEND,=11 ;SET WDCNT
MOVE A, RINP-9(K) ;GET WHAT'S IN R(2,K)
MOVEM A,XRN+=9(R) ;PUT IT IN P11
;;N4: SKIPE A,LOOP
;; MOVEM A,XRN+=9(R) ;IF(LOOP.NE.0)RN(IS+11)=LOOP (REAL)
N4: CAIGE IEND,3
MOVEI IEND,3
MOVE 15,IEND ;IF(IEND.LT.3)IEND=3
SUBI 15,2
JSA 16,UPDATE ;CALL UPDATE(IEND-2)
JUMP 15
NN2: CAML K,IZ ;2 CONTINUE
JRA 16,(16) ;END
ADDI K,=10
JRST N2
CNT: 0
MSSLUP: 0
SETZ 1, ;161 CNT=1
SETZ 2,
L5543: MOVE 3,.COMM.+4(2) ;DO 5543 K=1,10
;; MOVE 3,(3) ;RA=RJQ(K)
SKIPE 3 ;IF(RA.NE.0)CNT=K
MOVE 1,2
;; MOVEI 4,RRJJ+1 ;5543 RJJ(K)=RA
MOVEM 3,RRJJ+1(2)
CAIG 2,=8 ; LOOP BACK?
AOJA 2,L5543
AOJ 1, ;********* WILL SAVE UP TO PARAM 12 ONLY!
MOVEM 1,CNT ;REMEMBERS CNT
JRA 16,(16)
LUP2: 0
;; MOVEI 1,XRN ;261 RN(I)=CNT
;; ADD 1,PTR+=252
FLTR 2,CNT ;MOVE 2,CNT
MOVE 1,PTR+=252
MOVEM 2,XRN-1(1)
FLTR 2,.COMM.+1 ;MOVE 2,.COMM.+1 ;RN(I+1)=JA
;I=I+2
MOVEM 2,XRN(1)
ADDI 1,2
MOVEM 1,PTR+=252
MOVE 3,.COMM. ;RN(I)=R2
MOVEM 3,XRN-1(1)
;; NOT USED NOW! IF(RD.NE.0)RN(I)=RD
;;C TO SAVE NOTE NUMBS IN P2.
SETZ 5, ;DO 4554 K=1,CNT
L4554: MOVE 2,.COMM.+4(5)
;;L4554: MOVEI 2,.COMM.+4 ;(RJQ)
;; MOVEM 2,(3) ;4554 RN(I+K)=RJQ(K)
MOVE 3,1
ADDI 3,(5)
MOVEM 2,XRN(3)
AOJ 5,
CAME 5,CNT
JRST L4554
AOJ 5,
ADDM 5,PTR+=252 ;3554 I=CNT+1+I
JRA 16,(16)
;;C****** FOR 'HOMING' OF BEAMS AND CHORD NOTES ***********
;; SUBROUTINE HOMER
;; IMPLICIT INTEGER(A-Q,S-Z)
;; REAL PWDS,DISX,A,B,PLACE,STFF
;; COMMON /STF/RSTFAC(-3/4),RSTJ2
;; COMMON R2,JA,CENTR,J2,RJQ(20),JQ(20) /POSI/STFF(-3/4),JJ2,POS
;; COMMON /XRN/RN(4000) /PTR/PWDS(250),ITEM,L,I,IX
;; COMMON/ALF/QQ(3),K,RA,RB,N,RG,M,X,RE,RF,A,B,DISX,INP(58)
;; EQUIVALENCE (R3,RJQ(1)),(R6,RJQ(4)),(J11,JQ(9)),(RD,RN(4000))
;; 1,(R7,RJQ(5)),(R9,RJQ(7)),(R11,RJQ(9)),(R13,RJQ(11))
;; 1,(J10,JQ(8)),(R8,RJQ(6)),(J7,JQ(5))
HOMER: 0 ; IF(JA.EQ.6)GO TO 9
MOVE MM,.COMM.+1
CAIN MM,6
JRST H9
SKIPE .COMM.+=14 ;IF(R13.NE.0)GO TO 10
JRST H10 ; FOR GENL HOMING; WORDS; BEAMS; STEMS;
; ALF+=14= IS = WIDTH OF NOTE -- NEEDED BECAUSE OF DIFF. STEM DIRECTIONS.
; NEXT ADJUSTS STEMS WHEN BEAMS ARE USED.
SETOM POSI+=8 ;197 JJ2=-1
MOVE R,.COMM. ;R3=R2
MOVEM R,DPYNEW
FIXX(R)
;; MOVE STF+3(R) ;RSTJ2
;; MOVEM STF+10
;; LATER, BECAUSE OF 'AD 99' MOVEM R,.COMM.+3 ;J2=STF#
MOVE IZ,[6.0]
MOVE PTR+=250 ;ITEMX=ITEM-1
SOJ
MOVEM ITEMX#
; ****** BIG LOOP ************
SETZ K, ;DO 191 K=1,ITEM
H191: MOVEM K,LOOP ;SAVE K L=PWDS(K)
MOVE L,PTR(K) ; L IS PWDS(K+1)
;IF(RN(L+1).NE.6)GO TO 191 -- NO ADJUSTMENT IF P10.NE.0
MOVEI R,XRN(L)
CAME IZ,(R)
JRST HX191
MOVE JK,DPYNEW ;IF(RN(L+2).EQ.R3)GO TO 77
CAMN JK,1(R)
JRST H77
CAMGE JK,[=5.0] ;IF(R3.LT.5.)GO TO 191
JRST HX191 ; TYPE AD 99 FOR ALL STAVES (=19 99)
;;H77: MOVE JK,-1(R) ;77
;; CAMN JK,[=8.0] ;IF(RN(L).EQ.8)GO TO 191
;; JRST HX191
H77: MOVE JK,6(R) ;IF(RN(L+7).LT.10.)GO TO 191 (TREMOLO )
SKIPL 7(R) ;IF P8.LT.0 THEN SKIP, UNATTACHED PARTIALS
CAMGE JK,[=10.0] ;C FINDS BEAMS.
JRST HX191
FDVR JK,[=10.0] ;X=RG/10.
FIXX(JK) ;C STEM DIRECT.
MOVEM JK,XNOTE ;X SAVED IN XNOTE=STEM DIR.
MOVE JK,1(R) ;R2=RN(L+2)
MOVEM JK,.COMM. ; USED IN 'FINDIT'
MOVE A,2(R) ;A=RN(L+3)-.01
FSBR A,[=0.01]
SETZM BOX ;BOX=0
MOVE 0,-1(R) ;IF(RN(L).LT.6)GO TO HX77
CAML [6.0]
SKIPL MM,=8(R) ;IF(RN(L+9).GE.0)GO TO HX77
JRST HX77
MOVE [2.44] ;A= - OR + NOTE WIDTH IF R9= -1 OR -2
FMPR STF+=8 ;*RSTJ2
AOJ MM, ;MM=MM+1
JUMPE MM,.+3
MOVEM BOX ;SAVE HORIZ. DISPLACEMENT FOR RIGHT SIDE.
SKIPA
FSBR A,0 ;CONSIDER LEFT SIDE PUSHED OVER NOTE WIDTH.
HX77: MOVEM A,NEWR ;SAVE A IN NEWR -- LEFT SIDE OF BEAM.
SETZM KRVRS# ;KRVRS=0
MOVE -1(R) ;IF(RN(L).LT.8)GO TO H1
CAMGE [8.0]
JRST H1
KIFIX MM,=9(R) ;IF(RN(L+10).GE.10)MM=RN(L+10)/10
CAIL MM,=10
IDIVI MM,=10
MOVEM MM,KRVRS ;KRVRS=MM
H1: MOVM RC,3(R) ;RC=ABS(RN(L+4)) RC USED AFTER H192
FSBR RC,[79.0] ;NEG=MAXI SIZE, POS=MINI SIZE BEAMS.
MOVE JK,5(R) ;B=RN(L+6)+.01
FADR JK,[=0.01] ;C POS 1 AND 2
SKIPE BOX ;IF(BOX.NE.0)JK=JK+BOX
FADR JK,BOX ;CONSIDER RIGHT SIDE PUSHED ONE NOTE WIDTH.
MOVEM JK,BAUTO ;B SAVED IN BAUTO - RIGHT SIDE OF BEAM.
FSBR JK,A ;DISX=B-A
MOVEM JK,UPDATE ;DISX SAVED IN UPDATE
; DISTANCE IN REAL STEPS
MOVEM R,NALF ;SAVE LOC OF RN(L+1)
MOVE 0,3(R)
MOVEM 0,JUGGLE
JSA 16,AMOD ;RF=AMOD(RN(L+4),100.0)
JUMP JUGGLE
JUMP [=100.0]
MOVEM 0,JUGGLE; THIS IS RF!!!!
; NOTE 2
KIFIX JK,1(R) ;J2=RN(L+2) THE STF#
MOVEM JK,.COMM.+3
MOVE STF+3(JK) ;RSTFAC(JK) --- RSTJ2
MOVEM STF+10
MOVE JK,NALF
MOVE JK,4(JK)
MOVEM JK,MSSLUP
JSA 16,AMOD ;RB=AMOD(RN(L+5),100.0)
JUMP MSSLUP
JUMP [=100.0] ;0 WILL HAVE RB!!!
FSBR 0,JUGGLE
MOVEM 0,SORT2 ;RD SAVED IN ALF+=9 -- RD=RB-RF
MOVEI NX,1
;******* INNER LOOP **********
H192: JSA 16,FINDIT ;IF(FINDIT(N))GO TO 192
JUMP NX
JUMPL 0,HX192
SETZM STFLG# ;FOR NOTES ON DIF. STF. (P10=1↓, =2↑)
SKIPE R,KRVRS ;JRVRS=KRVRS
MOVEM R,JRVRS#
MOVEI R,XRN ;IF(RN(L).EQ.8)GO TO 192
ADD R,PTR+=251 ;LOC OF RN(L+1)
MOVE -1(R) ;IF(RN(L).GE.8)MM=R10
CAMGE [8.0]
JRST H54
SKIPGE MM,=9(R) ;*********↓↓ NOTES ON DIFF. STAFF *************
JRST HX192 ;JUMP OUT IF R10 IS NEG.
JUMPE MM,H54
KIFIX MM,MM ;MUST BE FIXED FOR COMPARES.
MOVEM MM,STFLG ; STFLG HAS 1 ↓ OR 2 ↑
SETZM JRVRS
H54: JUMPGE RC,.+4 ;JUMP IF MINI-BEAMS. THEY WILL LOOK FOR MININOTES
MOVE JK,7(R) ;IF(RN(L+8).GE.1000.)GO TO 192
CAML JK,[=1000.0]
JRST HX192 ; SKIPS SLASHED GRACE NOTES (P8=1000 OR P10=1)
; FINDIT IS NEG. IF(RN(L+1).NE.1.OR.RN(L+3))
MOVE A,2(R) ;RC=RN(L+3)
;; MOVE JK,4(R) ;IF(X.NE.IFIX(RN(L+5)/10.))GO TO 192
KIFIX JK,4(R) ;FIXX(JK) **** JK HAS STEM DIR. OF NOTE
IDIVI JK,=10
CAMN JK,XNOTE ;IF(JK.NE.XNOTE.AND.JRVRS.NE.0)GO TO H50
JRST .+3
SKIPE JRVRS
JRST H5
MOVE -1(R) ;IF(RN(L).GE.8)GO TO H5
CAML [8.0]
JRST H5
CAME JK,XNOTE ;IF(STEM DIRECTIONS ARE SAME)GO TO HX4
JRST HX192 ;ELSE SKIP
JRST HX4
;;H5: SKIPGE MM,=9(R) ;*********↓↓ NOTES ON DIFF. STAFF *************
;; JRST HX192
;; JUMPE MM,HX4
;; KIFIX MM,MM ;MUST BE FIXED FOR COMPARES.
;; MOVEM MM,STFLG ; STFLG HAS 1 ↓ OR 2 ↑
H5: MOVE IEND,STF+10 ; GET RSTJ2
CAMN JK,XNOTE ; ARE STEM DIR'S OR NOTE AND BEAM THE SAME?
JRST HX4 ;IF(STEMDIR.EQ.STFLG)GO TO HX4
SKIPL RC ; IS IT A MINI?
FMPR IEND,[0.6] ; YES, *.6
MOVE IS,[2.44] ; 2.44 IS NOTE WIDTH
FMPR IS,IEND ; *RMINI
CAIE MM,1
MOVNS IS ; NEG. NOTE WIDTH
MOVE MM,NALF ; GET LOC OF RN(L+1) P1 OF THE BEAM
MOVE L,6(MM) ; MM=P7, NUMB OF BEAMS
MOVE -1(MM) ;IF(WDCNT.LT.8) SKIP
CAML [8.0]
FADR L,9(MM) ;ADD P10 (DISPLACEMENT)
JSA 16,AMOD ; GO FIND SECOND DIGIT.
JUMP L
JUMP [10.0]
MOVE MM, ; GET THE RESULT INTO RIGHT AC
FSBR MM,[1.0] ; LESS 1
FMPR MM,[1.571429] ; *SPACE BETWEEN BEAMS
FMPR MM,IEND
MOVEM MM,BOX ; BOX = ADDED DIST BETWEEN MULTIPLE BEAMS.
;XX FADR A,IS ; ADD OR SUB. NOTE WIDTH TO POS.
HX4: CAML A,NEWR ;IF(RC.LT.A)GO TO 192
CAMLE A,BAUTO ;IF(RC.GT.B)GO TO 192
JRST HX192 ; WHAT'S LEFT IS IN BEAM AREA IF STEM DIR. IS OK.
SKIPN IS,STFLG ; SKIP IF NOTE IS ON DIFF. STAFF
JRST HXX4 ;**********************↓↓↓↓↓↓↓↓↓↓************
CAMN JK,XNOTE ;JK IS STEM DIR. OF NOTE; XNOTE, FOR BEAM
JRST HXX4
MOVE L,NALF ;GET PTR TO BEAM
MOVE -1(L) ;IF WDCNT.LT.7 GO TO HXX4
CAMGE [7.0]
JRST HXX4
MOVE 7(L) ;GET P8
JUMPE HXX4 ;IF =0 GO ON
CAML A,7(L) ;CHECK SPAN OF ADDED BEAM
CAMLE A,=8(L)
JRST HX192 ;JUMP IF OUT OF RANGE
HXX4: FSBR A,NEWR ;RC=RC-A
MOVEM A,MVBEAM;SAVES RC
MOVEM JK,PARCH ;SAVE THE NOTE'S STEM DIR. IN 'PARCH'
MOVEM R,MVBX ;SAVE LOC OF RN(L+1)
MOVE 0,3(R)
MOVEM 0,MSSLUP
JSA 16,AMOD ;193 RE=AMOD(RN(L+4),100.0)
JUMP MSSLUP
JUMP [=100.0]
MOVEM 0,ALF+3 ;RE SAVE HERE
SKIPN MM,STFLG ; IF(STFLG.EQ.0)GO TO H577
JRST H577
MOVEI IS,1 ; IS=1
CAIE JK,2 ; IF(JK.NE.2)IS=-1 -- STEM ↑ =1
SETO IS,
MOVE R,.COMM.+3 ;NN=(STFF(R+IS)-STFF(R))/7.
MOVN NN,POSI+3(R)
ADD R,IS
FADR NN,POSI+3(R)
MOVE [7.0]
CAME JK,XNOTE ;JUMP NEXT IF STEM DIR OF NOTES = STF
FMPR IEND ; 7*RMINI
FDVR NN,0
MOVMS NN ; ABS VALUE
CAMN JK,XNOTE ;***WAS MM, *** IF(NOTESTM.NE.XNOTE)STML=STML+13.714
JRST H577-1
MOVE BOX
FDVR STF+10 ;ADJUST FOR MULTIPLE BEAMS. /RSTJ2
MOVEM BOX
FSBR NN,[13.714] ; -2:STEM LENGTH
FDVR NN,STF+10 ; /RSTJ2 FOR NON-1 STAFF SIZES.
H577: MOVE JK,SORT2 ;RC=RD*RC/DISX+RF
FMPR JK,MVBEAM ;*RC
FDVR JK,UPDATE ;/DISX
FADR JK,JUGGLE ;+RF
MOVEM JK,MVBEAM ;RC=
MOVE JK,MVBX
MOVE JK,6(JK) ;RG=RN(L+7)
MOVEM JK,ALF+4 ;SAVE RG
JSA 16,AMOD ;RN(L+7)=RG-AMOD(RG,10.0)+AMOD(RG,1.0)
JUMP ALF+4
JUMP [=10.0]
MOVEM 0,LUP2
JSA 16,AMOD
JUMP ALF+4
JUMP [=1.0]
FSBR 0,LUP2
FADR 0,ALF+4
MOVE L,MVBX
MOVEM 0,6(L) ;DELETES TAILS WITHOUT REMOVING DOTS OR SPACING OF DOTS.
; FRACTIONAL NOTE #
MOVE R,MVBEAM ;195 RA=RC-RE
FSBR R,ALF+3
MOVE JK,XNOTE ;IF(X.EQ.2)RA=-RA
CAIN JK,2
MOVNS R
MOVE 0,7(L) ;IF(RN(L+8).GT.999)RA=RA+1000. FOR MINI-NOTES
CAMLE 0,[999.0]
FADR R,[1000.0]
MOVE JK,PARCH ;GET NOTE'S STEM DIRECTION.
CAME JK,XNOTE ;IF STEM DIRS ARE SAME GO TO H52
SKIPN JRVRS ;IF(JRVRS.EQ.0)GO TO H52
JRST H52
MOVE NN,[13.714] ;FOR SUBTRACTING STEM LENGTH
CAME IEND,STF+10 ;IF(RMINI.NE.RSTJ2)NN=NN*0.6
;;; JRST H52-2
FMPR NN,[0.59] ;********ALL THIS CAN BE SIMPLER SOMEDAY*********
MOVE BOX
FDVR STF+10 ;[0.59] ;ADJUST FOR MULTIPLE BEAMS. (USE .59, NOT .6)
MOVEM BOX
FADR R,NN ;****** COMBINE IT WITH STUFF ON DIFF. STAFF*****
JRST H53 ;R=-(R+NN)
H52: SKIPN MM,STFLG ; IF(STFLG.EQ.0)GO TO HX192-3
JRST HX192-3 ;******** NEXT FOR NOTES ON DIFF. STF. *************
CAME MM,XNOTE ;ARE STEM DIRS. SAME?
JRST .+3 ;NO, JUMP
FADR R,NN ;ADD UP FOR STEM LENGTH IF SAME DIR.
JRST HX192-3 ; ALL DONE
FMPR NN,IEND ;*RMINI *************
FSBR R,NN ;R=R-NN
CAMN JK,XNOTE ;IS NT'S STM DIR. = DIFF. STF#(2=↑)?
JRST .+3 ;NO, SKIP NEXT TWO INSTRUCT'S.
H53: MOVNS R ;MAKE IT POS.
FADR R,BOX ; ADD SPACE FOR MULTIPLE BEAMS
MOVN [5.0] ;IF(RA.LT.-5)IGNORE IT.(STEM SUPPOSED TO BE OPPOSITE.)
CAMLE R,
MOVEM R,7(L) ;196 RN(L+8)=RA
; FRACTIONAL NOTE # - FIRST NOTE OF GROUP + THIS NOTE # ALL *7.
SKIPGE POSI+=8
MOVEM NX,POSI+=8 ; SAVES # OF LOWEST ITEM FOUND
HX192: CAMG NX,ITEMX ;192 CONTINUE ***WAS CAMGE****
AOJA NX,H192
HX191: MOVE K,LOOP ;191 CONTINUE
CAMG K,ITEMX ; ***** WAS CAMGE ******
AOJA K,H191
JRA 16,(16) ;RETURN
H9: SKIPGE .COMM.+=32 ;9 IF(J11.LT.0)RETURN
JRA 16,(16) ; IF P11=-1 NO HOMING
MOVM R,.COMM.+=28 ; X=IABS(J7)/10 CC X=R7/10.
IDIVI R,=10 ;;;FDVR R,[=10.0]
SKIPN 2,.COMM.+=31 ;IF(J10.EQ.0)GO TO H100
JRST H100
CAIL 2,=10 ;IF(J10.GE.10)X=0 (=LOOK AT ALL STEM DIRS.)
SETZ R,
H100: MOVEM R,XNOTE ;X SAVED IN XNOTE = STEM DIR. OF BEAM.
; R9= POS3
MOVNI RC,1 ;RC=-1
SKIPE .COMM.+=10 ;IF(R9.NE.0)RC=-2 ****OR .GT. *******
MOVNI RC,2
;??? MOVE .COMM.+=11 ;GET P10
;??? JUMPE H10 ;IGNORE IF 0
SKIPLE .COMM.+=8 ; SKIP IF R7 IS .LE.0
MOVNI RC,3 ; RC=0 ESCAPES FRCOM LOOP.
; HOMING RANGE FOR BEAMS
H10: MOVE IS,.COMM.+=12 ;10 IF(R11.EQ.0)R11=2.9
JUMPN IS,HX10
MOVE IS,[=2.9]
MOVEM IS,.COMM.+=12 ; IF P11.NE.0 RANGE IS CHANGED FROM 2
HX10: MOVE IZ,.COMM.+1 ; IF(JA.EQ.5)RC=-1
CAIN IZ,5
MOVNI RC,1
MOVEI K,1
MOVE L,.COMM.+1 ; JA IS NOW IN L
H361: JSA 16,FINDIT ;DO 361 K=1,ITEM
JUMP K
JUMPL 0,HX361 ;IF(FINDIT(K))GO TO 361
; SKIPS NOTES ON WRONG LINE
MOVEI R,XRN ;RD=RN(L+3)
ADD R,PTR+=251 ;LOC OF RN(L+1)
MOVE A,2(R) ;RD IN A
MOVEM A,RMOD+=9 ;1 IF(JA.NE.6)GO TO 177
MOVE JK,4(R) ;IF(IFIX(RN(L+5)/10).NE.X)GO TO 361
CAIE L,6
JRST H177
FIXX(JK)
IDIVI JK,=10 ;JK=NOTE'S STEM DIRECTION
SKIPN XNOTE ;IF(XNOTE.EQ.0)GO TO H177
JRST H177 ;XNOTE=0 = CHECK ALL STEM DIRS.
;X MOVE -1(R)
;X CAML [8.0]
;X SKIPN JT, =9(R) ;JT='OTHER STAFF' INFO 2=↑ 1=↓
;X JRST H377 ;IF(RN(L+10).EQ.0)GO TO H377
CAMN JK,XNOTE
JRST H377
MOVE 1,[2.44]
FMPR 1,STF+=8 ;*RSTJ2
MOVM NN,.COMM.+=25 ;IF(ABS(J4.GE.100) *.6 (MINI)
CAIL NN,=90
FMPR 1,[0.6]
CAIE JK,1
MOVNS 1
FADR A,1 ; ADD OR SUB. NOTE WIDTH FROM NOTE POS.
JRST H177 ;ALL NOTES ON 'DIFF. STF' ARE CONSIDERED.
H377: CAME JK,XNOTE
JRST HX361
H177: JSA 16,PLACE ;177 IF(PLACE(R3))GO TO 461
JUMP .COMM.+4
JUMPL H461
SETOM IZ
HX2: MOVE 5(R) ;GET PARAM 6
CAMGE [10.0] ; MUST BE .GE.10
JRST HX1
MOVE IS,[2.44] ; SIZE OF A NOTE
CAML [20.0] ; 10 = RIGHT SHIFT, 20 = LEFT SHIFT
MOVNS IS
MOVM 3(R) ; GET P4
CAML [100.0] ; IS IT A MINI?
CAML [200.0]
SKIPA
FMPR IS,[0.6] ;*RMINI
MOVE 1,.COMM.+3 ;STAFF #
FMPR IS,STF+3(1) ;*RSTFAC(J2)
FADR A,IS
HX1: JUMPG IZ,HX8 ; JUMP TO CHANGE P6, 8 OR 9
HX3: MOVEM A,.COMM.+4 ;R3=RD
; LOOKS FOR NOTE, STAFF #, STEM DIR.
MOVN .COMM.+=14 ;P13=-1 HOME TO NOTE SIDE, =-2 TO STEM.
SKIPG ;IS IT NEG.
JRST H11 ; NO, GO TO NEXT SECTION.
MOVE IS,3(R) ; VERTICAL POS OF NOTE (P4)
CAME [1.0] ;IS P13 -1 OR -2?
JRST H12 ;IT'S -2
MOVE [2.0]
CAMGE JK,[20.0] ;WHICH WAY IS STEM?
MOVNS
FADR IS ;ADD NOTE LEVEL
MOVEM .COMM.+5 ;P4=NOTE LEVEL + OR - 2.
JRST H11
H12: MOVE IZ,7(R) ; STEM LENGTH
CAMN IZ,[999.0] ; WHAT ABOUT 16TH AND 32ND NOTES??
SETZ IZ,
FADR IZ,[8.0]
JSA 16,AMOD
JUMP 6(R)
JUMP [10.0] ;AC0=AMOD(R7,10.0)
SKIPN
JRST H13
FSBR [1.0] ;IGNORE 1ST TAIL
FMPR [1.8] ; *SPACE FOR EACH TAIL
FADR IZ, ; ADD TO STEM LENGTH
H13: CAML JK,[20.0]
MOVNS IZ ;PUT IT UPSIDE DOWN.
FADR IS,IZ ;ADD NOTE LEVEL
MOVEM IS,.COMM.+5 ;PUT IT BEYOND STEM
H11: CAIN L,6 ;IF(JA.EQ.6)GO TO 861
JRST H861
CAIN L,5 ;IF(JA.EQ.5)GO TO 261
JRST H261
JRA 16,(16) ;RETURN
H461: CAIN L,6 ;461 IF(JA.EQ.6)GO TO 277
JRST H277
CAIE L,5 ;IF(JA.NE.5)GO TO 361
JRST HX361
H277: JSA 16,PLACE ;277 IF(PLACE(R6))GO TO 561
JUMP .COMM.+7
JUMPL H561
MOVEI IZ,7 ;R6=RD
JRST HX2
H861: MOVE 0,.COMM.+=28 ;861 IF(J7.GE.0)GO TO 261
JUMPGE 0,H261
H561: JSA 16,PLACE ;561 IF(PLACE(R9))GO TO 661
JUMP .COMM.+=10 ;R9
JUMPL H661
MOVE 0,.COMM.+=28 ;IF(J7)GO TO 761
JUMPL H761 ; J7=NEG MEANS TREMOLO
MOVE 0,.COMM.+=9 ; IF(R8.NE.0)GO TO 761
JUMPN H761
MOVE 0,.COMM.+=11 ; IF(R10.EQ.0)GO TO 361
JUMPE HX361
H761: MOVEI IZ,=10 ;761 R9=RD
JRST HX2
; R8=0, R10=0 MEANS R9 IS NUMBER OUTSIDE OF BEAM. ; GO TO 261
H661: CAIN L,5 ;661 IF(JA.EQ.5)GO TO 361
JRST HX361
;; MOVE 0,.COMM.+=31 ;IF(J10.LT.30)GO TO 361
;; CAIGE 0,=30
SKIPN .COMM.+=31 ;IF J10.EQ.0 GO TO 361
JRST HX361
JSA 16,PLACE ;IF(PLACE(R8))GO TO 361
JUMP .COMM.+=9
JUMPL HX361 ; HOMES INNER PARTIAL BEAMS
MOVEI IZ,=9 ;R8=RD
JRST HX2
HX8: MOVEM A,.COMM.(IZ) ;PUT A INTO RIGHT PARAM.
H261: SKIPN RC ;261 IF(RC.EQ.0)RETURN
JRA 16,(16)
AOJ RC ;RC=RC+1
HX361: CAMGE K,PTR+=250 ;361 CONTINUE
AOJA K,H361
JRA 16,(16) ; END
FSCAN: 0
INCHRW
MOVE 2,[ASCII/ /]
MOVEM 2,ALF
MOVE 2,[XWD ALF,ALF+1]
BLT 2,ALF+=71 ; CLEANS OUT INP ARRAY
CAIN ";"
JRA 16,(16)
CAIN ":"
JRA 16,1(16)
CAIN "("
JRA 16,2(16)
CAIN ")"
JRA 16,3(16)
CAIN "/"
JRA 16,4(16)
CAIN "*"
JRA 16,5(16)
CAIN "X"
JRA 16,6(16)
CAIN "C"
JRA 16,7(16)
JRA 16,8(16)
NALF: 0
MOVE 0,@(16)
JUMPGE .+4 ;IF(I.GE.0)GO TO 20
MOVE 1,[405004020100] ; J='A'=405004020100
SETO 2, ; M=-1
JRST .+3 ;GO TO 10
MOVE 1,[201004020100] ;20 J=' '=201004020100
MOVEI 2,=16 ; M=16
SUB 0,1 ;10 NALF=(I-J)/536870912-M
IDIV 0,[3777777777]
SUB 0,2
JRA 16,1(16)
BOX: 0 ;CALL BOX(I,R) SEE PLTSRT.F4 FOR FORTR. VERSION
MOVE 14,@(16) ; I IS IN 14
JUMPL 14,BX4
KIFIX 13,@1(16) ;MOVE 13,@1(16) ; GET R
;; FIXX(13) ; K=R
JSA 16,AMOD
JUMP XRN+3(14) ; GET REAL P4
[100.0]
CAMGE [-20.0] ;IF(P4.LT.-20)P4=P4+100
FADR [100.0] ; FOR P4=-95 ETC.
CAML [80.0] ;IF(P4.GE.80)P4=P4-100
FSBR [100.0] ; CATCHES NEG. MINIS, ETC.
FMPR [7.0]
FMPR STF+3(13) ;*STAFF FACTOR
FADR POSI+3(13) ; + STAFF VERT. POS.
FSBR [40.0] ; SHIFT CURSOR DOWN A BIT.
FMPR SIZ
KIFIX 13,0 ;MOVE 13,
;; FIXX(13)
SUB 13,SIZ+2 ;13=K
JSA 16,RHORZ ; GET HORIZ. POS.
JUMP XRN+2(14)
FMPR SIZ ;SIZ IS FOR ZOOMED IMAGES
KIFIX 12,0 ;MOVE 12, ; 12=L
;; FIXX(12)
SUB 12,SIZ+1
CAIL 12,=550 ; CHECK IF OUT OF BOUNDS OF CRT
MOVEI 12,=511
CAMG 12,[-=550]
MOVE 12,[-=511]
JSA 16,SETCUR
12
13
[0]
JRA 16,2(16) ; THE CURSOR IS IN POSITION
BX4: CAME 14,[-1]
JRST BX5
JSA 16,DPYSET
[3]
RINP
[=100]
JSA 16,DPYBRT
[3]
BX5: MOVE 2,@1(16) ; GET R
JSA 16,RHORZ
2
FMPR SIZ
FIXX(0)
SUB SIZ+1
MOVM 2,
CAILE 2,=550
JRST BX6
MOVEM 0,LOOP
JSA 16,SETPOG
[3]
JSA 16,ALINE
LOOP
[-=511]
LOOP
[=511]
JSA 16,DPYOUT
[3]
BX6: JSA 16,SETPOG
[1]
JRA 16,2(16)
PARCH: 0 ;CALL PARCH(JA,JJA,RD)
MOVE 2,@(16) ;GET JA
CAIN 2,2 ;IS IT P2
JRST .+8
CAIE 2,1 ;IS IT P1
JRA 16,3(16) ;NEITHER
KIFIX 3,@2(16) ;GET RD
JUMPE 3,.+3 ; REJECTS CODE # 0.
CAIG 3,=18 ;IS PARAM .GT.18?
MOVEM 3,@1(16) ;PUT IT INTO JJA
JRA 16,3(16) ;ALL DONE
MOVE 3,@2(16) ;GET RD
CAMG 3,[4.0] ;REJECTS STAFF # .GT.4
MOVEM 3,RRJJ ; PUT IT AWAY
JRA 16,3(16)
END